C
C     This file contains routines which call system specific functions
C     IRIS-4D version (MIPS Fortran 77 compiler)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      SUBROUTINE JOBJE
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     JOBJE retrieves operating system parameters
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'COM_JOBD.INC'
C
      JOBNAM=0
      LSRU=0
      LTIM=0
      IAF=JOBORG()
      RETURN
      END
C
C
C
      SUBROUTINE CMPILX
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     CMPILX retrieves compilation date and time
C     Now done directly by BLOCK DATA CMPSET 
C     (see ~rull/bin/cmpset and makefile e.g. of merz)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'COM_JOBD.INC'
C
C      CMPDAT=' '
C      CMPTIM=' '
      RETURN
      END
C
C
C
      SUBROUTINE SETR1G(IFLAG)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     SETR1G sets operating system flag to IFLAG
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      RETURN
      END
C
C
C
      FUNCTION IGTR1G
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     IGTR1G retrieves operating system flag 
C     Use GETENV instead!
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      RETURN
      END
C
C
C
      FUNCTION JOBORG
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     JOBORG sets origin type (TRUE for interactive processing,
C                              FALSE for batch processing mode)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'STANDFIL.INC'
      LOGICAL JOBORG
      LOGICAL ISATTY
      JOBORG=.TRUE.
C----- this is still a test
C     JOBORG=ISATTY(ITXOUT)
      RETURN
      END
C
C
C
      FUNCTION GETDAT
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     GETDAT sets current date
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      CHARACTER*(*) GETDAT
      CHARACTER*9 BUF
      CALL DATE(BUF)
      GETDAT=BUF
      RETURN
      END
C
C
C
      FUNCTION GETTIM
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     GETTIM sets current time
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      CHARACTER*(*) GETTIM
      CHARACTER*8 BUF
      CALL TIME(BUF)
      GETTIM=BUF
      RETURN
      END
C
C
C
      SUBROUTINE SYSTEM(NERR,STRING)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     SYSTEM forces fatal (NERR=52) or non-fatal (NERR=51) error
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      CHARACTER*(*) STRING
   10 FORMAT(1X,A)
      PRINT 10,STRING
      IF (NERR.EQ.51) RETURN
C----- signal 16 corresponds to SIGUSR1 (see SIGNAL(2))
      IF (NERR.EQ.52) CALL EXIT(16)
      END
C
C
C
      SUBROUTINE MESSGE(STRING,OPTION)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     Subroutine MESSGE writes a string to the job dayfile (logfile),
C     to a communication area (o.s. dependent) or the permanent file history.
C     option = 'DAYF' : job dayfile
C                       (also histry if .not. iaf and medium or long job;
C                        CYBER only)
C            = 'HIST' : history file (see subr. histry)
C            = 'DISP' : status message to a 'display' (communication area)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'COM_JOBD.INC'
C
      CHARACTER STRING*(*), OPTION*4
C
      IF (OPTION.EQ.'HIST') THEN
         CALL HISTRY(STRING)
         RETURN
      ENDIF
C
C----- PREPARE FOR CALL TO KONTRL:
C      IOP=4 : DAYFILE
C      IOP=1 : STATUS DISPLAY
C
      IOP=4
      IF (OPTION.EQ.'DISP') IOP=1
      CALL KONTRL(STRING,IOP)
C
      RETURN
      END
C
C
C
      SUBROUTINE KONTRL(STR,IOP)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     KONTRL writes message STR to dayfile (logfile) if IOP=4
C     or to a status display if IOP=1.
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      CHARACTER*(*) STR
C
      RETURN
      END
C
C
C
      SUBROUTINE HISTRY(STRING)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     Subroutine HISTRY writes a string to a permanent file history.
C     The file is retrieved before and replaced after the operation.
C     Together with the string the jobsystemname JOBNAM, date and time are
C     written. The information is put after the last line with the same
C     JOBNAM, or at the end of file.
C     JOBNAM in /JOBDAT/ should contain the jobsystemname (left justified,
C     zero fill to the right; see subr. JOBJE)
C     The string should no be longer than 55 characters.
C     HISTRY uses file-unitnumbers 998 and 999.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      CHARACTER*(*) STRING
C
      RETURN
      END
C
C
C
      SUBROUTINE GETCPT(TIM)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     Subroutine GETCPT retrieves the accumulated CPU time in seconds.
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      REAL TARRAY(2)
C
C----- ETIME gives the sum of user and system time.
C----- TARRAY(1) gives the user time
C----- TARRAY(2) gives the system time
      TIM=ETIME(TARRAY)
      RETURN
      END
C
C
C
      INTEGER FUNCTION SCRMBL(A)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     Function SCRMBL returns a bit pattern resulting from scrambling
C     the bit pattern of argument A.
C     This routine is copied from the VAX version
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      PARAMETER (N=31)
C----- ASSUMING 32 BITS PER WORD
      INTEGER A,X
      LOGICAL IA(0:N),IT
C
      DO 10 K=0,N
      IA(K)=BTEST(A,K)
   10 CONTINUE
      ISEED=A
      DO 20 I=0,N
      CALL RANDOM(RR,ISEED)
      K=IFIX(N*RR)
      CALL RANDOM(RR,ISEED)
      L=IFIX(N*RR)
      IT=IA(K)
      IA(K)=IA(L)
   20 IA(L)=IT
      X=0
      DO 30 K=0,N
      IF (IA(K)) X=IBSET(X,K)
   30 CONTINUE
      SCRMBL=X
      RETURN
      END
C
C
C
      FUNCTION LOCATE(A)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     LOCATE returns address of A.
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      LOCATE=%LOC(A)
      RETURN
      END
C
C
C
      FUNCTION LENCM
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     LENCM returns amount of used memory
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      LENCM=0
      RETURN
      END
C
C
C
      SUBROUTINE MAKRAN(I)
C***********************************************************************
C     MAKRAN generates a 'random' bit pattern in I
C     This routine is copied from the VAX version
C***********************************************************************
C
      INTEGER SCRMBL
C
      CALL IDATE(IM,ID,IY)
      IX = IFIX ( FLOAT(IM)*31 + FLOAT(ID) + FLOAT(IY)*372 )
      CALL RANDOM(RR,IX)
C
      T=SECNDS(0.0)
      IT = IFIX(T)
      CALL RANDOM(RR,IT)
C
      I=IEOR(SCRMBL(IX),SCRMBL(IT))
      RETURN
      END
C
C
C
      SUBROUTINE RANSET(ISEED)
C***********************************************************************
C     RANSET sets the seed in /RNDGEN/ to be used by RANGET
C***********************************************************************
      INTEGER SEED
      COMMON /RNDGEN/ SEED
      SEED=(ISEED/2)*2+1
      RETURN
      END
C
C
C
      SUBROUTINE RANGEN
C***********************************************************************
C     RANGEN initializes seed for RANGET by using MAKRAN
C***********************************************************************
      CALL MAKRAN(I)
      CALL RANSET(I)
      RETURN
      END
C
C
C
      FUNCTION RANGET
C***********************************************************************
C     RANGET calls random number routine with seed stored in /RNDGEN/
C     Here the routine RANDOM is used.
C     Be careful with sequential calls to RANGET..could be optimized away..
C     use RANSUB instead
C***********************************************************************
      INTEGER SEED
      COMMON /RNDGEN/ SEED
      CALL RANDOM(X,SEED)
      RANGET=X
      RETURN
      END
      SUBROUTINE RANSUB(X)
C***********************************************************************
C     RANSUB calls random number routine with seed stored in /RNDGEN/
C     Here the routine RANDOM is used.
C     Identical to function RANGET.
C***********************************************************************
      INTEGER SEED
      COMMON /RNDGEN/ SEED
      CALL RANDOM(X,SEED)
      RETURN
      END
